<!--#include file="systemvariables.asp" -->

<%
'作者：山林客（ah_bill）
'博客：http://ruizhinet.blog.163.com
'网站：http://www.ruizhinet.cn
'本信息不会影响您网站的正常访问，请保留

if RZ_IN<>1 then
	response.write("非法请求")
	response.end
end If


'清理
Sub Terminal()
	If IsObject(conn) Then 
		Set conn=Nothing
	End If 
	If IsObject(S_ARTICLE_SHOW) Then 
		Set S_ARTICLE_SHOW=Nothing
	End If 
	If IsObject(S_LIST) Then 
		Set S_LIST=Nothing
	End If 
	If IsObject(S_SHOW) Then 
		Set S_SHOW=Nothing
	End If 
	If IsObject(S_ARTICLE_LIST) Then 
		Set S_ARTICLE_LIST=Nothing
	End If 
	If IsObject(S_PRODUCT_SHOW) Then 
		Set S_PRODUCT_SHOW=Nothing
	End If 
	If IsObject(S_PRODUCT_LIST) Then 
		Set S_PRODUCT_LIST=Nothing
	End If 
	If IsObject(S_PHOTO_SHOW) Then 
		Set S_PHOTO_SHOW=Nothing
	End If 
	If IsObject(S_PHOTO_LIST) Then 
		Set S_PHOTO_LIST=Nothing
	End If 
	If IsObject(S_TYPE_SHOW) Then 
		Set S_TYPE_SHOW=Nothing
	End If 
	If IsObject(S_SPECIAL_SHOW) Then 
		Set S_SPECIAL_SHOW=Nothing
	End If
	If IsObject(S_SPECIAL_LIST) Then 
		Set S_SPECIAL_LIST=Nothing
	End If 
	If IsObject(S_CRUMB) Then 
		Set S_CRUMB=Nothing
	End If 
	If IsObject(S_RZPARAM) Then 
		Set S_RZPARAM=Nothing 
	End If 
	If IsObject(S_RZPAGE) Then 
		Set S_RZPAGE=Nothing
	End If 
End Sub 

'设置全局配置信息
sub SetSiteConfig()
	Dim rsCfg,sqlCfg
	Set rsCfg = Server.CreateObject("ADODB.Recordset")
	sqlCfg = "select * from [c_settings]"
	rsCfg.open sqlCfg,conn,1,1
	If not rsCfg.eof and not rsCfg.bof Then
		Application.Lock
		Application(RZ_APP_PRE&"Readed")="OK"
		Do While Not rsCfg.eof
			Set Application(RZ_APP_PRE&rsCfg("var_name"))=Nothing 
			Application(RZ_APP_PRE&rsCfg("var_name"))=rsCfg("var_value")
		rsCfg.movenext
		Loop
		Application.unlock
	End If
	rsCfg.close
	Set rsCfg=nothing
end Sub
If Application(RZ_APP_PRE&"Readed")<>"OK" Then Call SetSiteConfig()

'设置输出字符串信息
sub SetSiteWords()
	Dim rsCfg,sqlCfg
	Set rsCfg = Server.CreateObject("ADODB.Recordset")
	sqlCfg = "select * from [c_words]"
	rsCfg.open sqlCfg,conn,1,1
	If not rsCfg.eof and not rsCfg.bof Then
		Application.Lock
		Application(RZ_APP_PRE&"Words")="OK"
		Do While Not rsCfg.eof
			Set Application(RZ_APP_PRE&rsCfg("w_name"))=Nothing 
			Application(RZ_APP_PRE&rsCfg("w_name"))=rsCfg("w_value")
		rsCfg.movenext
		Loop
		Application.unlock
	End If
	rsCfg.close
	Set rsCfg=nothing
end Sub
If Application(RZ_APP_PRE&"Words")<>"OK" Then Call SetSiteWords()

'设置分类信息
sub SetTypeProperties()
	Dim rsCfg,sqlCfg
	Set rsCfg = Server.CreateObject("ADODB.Recordset")
	sqlCfg = "select * from [c_type]"
	rsCfg.open sqlCfg,conn,1,1
	If not rsCfg.eof  Then
		Application.Lock
		Do While Not rsCfg.eof
			ReDim properties(10)
			properties(0)=rsCfg("path")
			properties(1)=rsCfg("pathname_chn")
			properties(2)=rsCfg("pathname_eng")
			properties(3)=rsCfg("keyword_chn")
			properties(4)=rsCfg("keyword_eng")
			properties(5)=rsCfg("fenlei")
			properties(6)=rsCfg("url")
			properties(7)=rsCfg("perpage")
			properties(8)=rsCfg("template")
			properties(9)=rsCfg("recordtemplate")
			Set Application(RZ_APP_PRE&"Type"&rsCfg("id"))=Nothing 
			Application(RZ_APP_PRE&"Type"&rsCfg("id"))=properties
		rsCfg.movenext
		Loop
		Application(RZ_APP_PRE&"TypeProperties")="OK"
		Application.unlock
	End If
	rsCfg.close
	Set rsCfg=Nothing
end Sub
If Application(RZ_APP_PRE&"TypeProperties")<>"OK" Then Call SetTypeProperties()

'读取分类属性
Function GetTypeProperty(typeid,key)
	If Application(RZ_APP_PRE&"TypeProperties")<>"OK" Then Call SetTypeProperties()
	Dim arr,result
	arr=Application(RZ_APP_PRE&"Type"&typeid)
	If Not isarray(arr) Then
	WriteWarning("<li>执行GetTypeProperty("&typeid&","&key&")出错，请检查ID为"&typeid&"的分类是否存在并修改模板</li>")
	Exit Function 
	End If 
	Select Case key
	Case "path":
		result=arr(0)
	Case "pathname_chn":
		result=arr(1)
	Case "pathname_eng":
		result=arr(2)
	Case "keyword_chn":
		result=arr(3)
	Case "keyword_eng":
		result=arr(4)
	Case "fenlei":
		result=arr(5)
	Case "url":
		result=arr(6)
	Case "perpage":
		result=arr(7)
	Case "template":
		result=arr(8)
	Case "recordtemplate":
		result=arr(9)
	Case else:
		WriteError("GetTypeProperty("&typeid&","&key&")的key参数有误")
	End Select 
	GetTypeProperty=result
End Function

'设置动态模块信息
sub SetRZModels()
	Dim rsCfg,sqlCfg
	Set rsCfg = Server.CreateObject("ADODB.Recordset")
	sqlCfg = "select * from [c_model]"
	rsCfg.open sqlCfg,conn,1,1
	If not rsCfg.eof  Then
		Application.Lock
		Do While Not rsCfg.eof
			ReDim properties(4)
			properties(0)=rsCfg("description_chn")
			properties(1)=rsCfg("description_eng")
			properties(2)=rsCfg("template")
			properties(3)=rsCfg("params")
			Set Application(RZ_APP_PRE&"RZModel"&rsCfg("modelname"))=Nothing 
			Application(RZ_APP_PRE&"RZModel"&rsCfg("modelname"))=properties
		rsCfg.movenext
		Loop
		Application(RZ_APP_PRE&"RZModels")="OK"
		Application.unlock
	End If
	rsCfg.close
	Set rsCfg=Nothing
end Sub
If Application(RZ_APP_PRE&"RZModels")<>"OK" Then Call SetRZModels()

'读取动态模块属性
Function GetModelsProperty(modelname,key)
	If Application(RZ_APP_PRE&"RZModels")<>"OK" Then Call SetRZModels()
	Dim arr,result
	arr=Application(RZ_APP_PRE&"RZModel"&modelname)
	If Not isarray(arr) Then
	WriteWarning("<li>执行GetModelsProperty("&modelname&","&key&")出错，请检查名称为"&modelname&"的动态模块是否存在并修改模板</li>")
	Exit Function 
	End If 
	Select Case key
	Case "description":
		If S_LANG=1 Then 
		result=arr(1)
		Else
		result=arr(0)
		End If 
	Case "template":
		result=arr(2)
	Case "params":
		result=arr(3)
	Case else:
		WriteError("GetModelsProperty("&modelname&","&key&")的key参数有误")
	End Select 
	GetModelsProperty=result
End Function


'替换特殊字符
function HTMLEncode(fstring)
	if not isnull(fstring) Then
		fstring = Trim(fstring)
		fstring = replace(fstring, ">", "&gt;")
		fstring = replace(fstring, "<", "&lt;")
		fstring = replace(fstring, chr(32), "&nbsp;")
		fstring = replace(fstring, chr(9), "&nbsp;")
		fstring = replace(fstring, chr(34), "&quot;")
		fstring = replace(fstring, chr(39), "&#39;")
		fstring = replace(fstring, "{", "&#123;")
		fstring = replace(fstring, chr(13), "")
		fstring = replace(fstring, chr(10) & chr(10), "</p><p> ")
		fstring = replace(fstring, chr(10), "<br> ")
		HTMLEncode = fstring
	Else
	HtmlEncode=""
	end if
end Function


Function ReplaceBad(content)
	If IsNull(content) Or content="" Then Exit Function 
	Dim RegEx
	Set RegEx = New RegExp
	RegEx.Pattern = "script|frame|meta|on.+=.+>"
	RegEx.MultiLine = True
	RegEx.IgnoreCase=True
	RegEx.Global = True
	content = RegEx.Replace(content, "")
	ReplaceBad = content
End Function



'恢复特殊字符
function ReHTMLEncode(fstring)
	if not isnull(fstring) then
		fstring = replace(fstring, "&gt;", ">")
		fstring = replace(fstring, "&lt;","<")
		fstring = replace(fstring, "&nbsp;",chr(32))
		fstring = replace(fstring, "&nbsp;",chr(9))
		fstring = replace(fstring, "&quot;",chr(34))
		fstring = replace(fstring, "&#39;",chr(39))
		fstring = replace(fstring, "",chr(13))
		fstring = replace(fstring, "</p><p> ",chr(10) & chr(10))
		fstring = replace(fstring, "<br> ",chr(10))
		ReHTMLEncode = fstring
	Else
	ReHTMLEncode=""
	end if
end function

'清除HTML标记
Function ClearHTMLChn(content)  
	If IsNull(content) Or content="" Then Exit Function 
	content = Replace(content, "&nbsp;"," ")
	Dim RegEx
	Set RegEx = New RegExp
	RegEx.Pattern = "<[^>]*>|(\s)*"
	RegEx.Global = True
	content = RegEx.Replace(content, "")
	content = Replace(content, "　","")
	ClearHTMLChn = content
End Function

Function ClearHTML(content)  
	If IsNull(content) Or content="" Then Exit Function
	content = Replace(content, "&nbsp;"," ")
	Dim RegEx
	Set RegEx = New RegExp
	RegEx.Pattern = "<[^>]*>"
	RegEx.Global = True
	content = RegEx.Replace(content, "")
	content = Replace(content, "　　","　")
	ClearHTML = content
End Function

'取得整数参数
Function GetIntQueryString(param)
	dim tempString,intvalue
		tempString=request.QueryString(param)
	If tempString="" Then 
		tempString=request.Form(param)
	End If
	If tempString<>"" Then
		tempString=HTMLEncode(tempString)
	End If
	intvalue = 0
	if tempString<>"" and isNumber(tempString) then
		intvalue=CInt(tempString)
	end if
	GetIntQueryString=intvalue
End Function 

'生成随机字符串
Function Gen_key(digits)
	dim char_array(80)
	dim i,output
	output=0
	dim num
	For i = 0 To 9
		char_array(i) = CStr(i)
	Next
	For i = 10 To 35
		char_array(i) = Chr(i + 55)
	Next
	For i = 36 To 61
		char_array(i) = Chr(i + 61)
	Next
	Randomize
	do while len(output) < digits
		num = char_array(Int(62 * Rnd))
		output = output&num
	loop
	Gen_key = output
End Function

'防止频繁刷新
Function CheckRefresh()
Dim sec
sec=app("rz_refreshtime")
If Not IsEmpty(Session("visit")) and isNumber(Session("visit")) and int(sec) > 0 Then
if (timer()-int(Session("visit")))*1000 < sec * 1000 then
   Response.write ("<meta http-equiv=""refresh"" content="""& sec &""" />")
   out("lang_refreshtoofast")
   Session("visit") = timer()
   Response.end
end if
End If
Session("visit") = timer()
End Function

'双语文本项输出
Function out(key)
	Dim appkey
	appkey=app(key)
	If appkey<>"" Then 
		Dim key_arr
		key_arr=Split(appkey,"|")
		If UBound(key_arr)=1 Then 
			If S_LANG=1 Then
				response.write(key_arr(0))
			Else
				response.write(key_arr(1))
			End If 
		Else
			response.write(appkey)
		End If 
	End If 
End Function

'双语文本项获取
Function getstr(key)
	Dim appkey,key_arr,key_value
	appkey=app(key)
	If appkey<>"" Then 
		key_arr=Split(appkey,"|")
		If UBound(key_arr)=1 Then 
			If S_LANG=1 Then
				key_value=key_arr(0)
				key_value=Replace(key_value,"&nbsp;"," ")
			Else
				key_value=key_arr(1)
				key_value=Replace(key_value,"&nbsp;"," ")
			End If 
		Else
			key_value=appkey
		End If 
		getstr=key_value
	End If 
End Function

'读取Application变量
Function app(key)
	If Application(RZ_APP_PRE&"Readed")<>"OK" Then Call SetSiteConfig()
	app=Application(RZ_APP_PRE&key)
End Function


'双语文本获取
Function text(chnkey,engkey)
	Dim key_value
	If S_LANG=1 Then
		key_value=engkey
	Else
		key_value=chnkey
	End If 
	text=key_value
End Function

'检查文件是否存在
Function FileExist(filepath)
	Dim temppath,fso
	If filepath="" Then
		FileExist=False
	Else
		On Error Resume next
		temppath=Server.Mappath(filepath)
		Set fso= Server.CreateObject("Scripting.FileSystemObject")
		If fso.FileExists(temppath) Then
		   FileExist=true
		Else
		   FileExist=false
		End If  
	End If 
End Function 

'读取文本文件
Function ReadFile(inputPath) 
	Dim txtPath
	txtPath=inputPath
	If Not FileExist(txtPath) Then
		ReadFile = "" 
		Exit Function
	End If 
	If txtPath = "" OR IsNull(txtPath) Then 
		ReadFile = "" 
		Exit Function 
	End If 
	txtPath = Server.MapPath(txtPath) 
	dim content, stream 
	On Error Resume next
	set stream=server.CreateObject("adodb.stream") 
	stream.Type=2
	stream.mode=3 
	stream.charset="UTF-8" 
	stream.open 
	stream.loadfromfile txtPath 
	content=stream.readtext 
	stream.Close 
	set stream=nothing 
	ReadFile=content 
End Function 

'读取HTML文件，并对模板路径进行处理
Function ReadHTMLFile(inputPath) 
	Dim content
	content=ReadFile(inputPath) 
	content=DataBaseTags(content)
	content=ExecTemplateHref(content)
	ReadHTMLFile=content
End Function 

'读取Tag文件
Function ReadTagFile(s_Template)
	If s_Template<>"" Then 
		If  Right(s_Template,5)=".html" Then 
			If InStr(s_Template,"/")=0 Then 
				ReadTagFile=ReadHTMLFile(GetPath("tags/"&s_Template))
			Else
				ReadTagFile=ReadHTMLFile(GetPath(s_Template))
			End If 
		Else 
			ReadTagFile=s_Template
		End If
	End If 
End Function 

'保存文本文件
Function SaveFile(inputPath,byval content)   
	Dim txtPath
	txtPath=inputPath
	If txtPath = "" OR IsNull(txtPath) Then 
		SaveFile = "" 
		Exit Function 
	End If 
	txtPath = Server.MapPath(txtPath) 
	Dim stream 
	On Error Resume next
	set stream=server.CreateObject("adodb.stream") 
	stream.Type=2 
	stream.mode=3 
	stream.charset="UTF-8"
	stream.open 
	stream.WriteText content 
	stream.SaveToFile txtPath,2     
	stream.flush 
	stream.Close 
	set stream=nothing 
End Function 

'去除Path前的0,和最后的,
Function CutPath(rsPath)   
	Dim path,temp
	path=rsPath
	If path<>"" Then
		temp=Mid(path,3)
		CutPath=Left(temp,Len(temp)-1)
	Else
		CutPath=""
	End If 
End Function 

'恢复Path，前面补“0,”，后面补“,”
Function FillPath(rsPath)   
	Dim path,temp
	path=rsPath
	If path<>"" Then
		FillPath="0,"&path&","
	Else
		FillPath=""
	End If 
End Function 

'输出错误并终止
Function WriteError(Msg)
	Response.Write("<span style='color:red'>"&Msg&"</span>")
	Response.End()
End Function

'输出错误但终止
Function WriteWarning(Msg)
	Response.Write("<span style='color:red'>"&Msg&"</span>")
End Function

'将原始路径跟RZ_ROOT合并
Function GetPath(inputpath)
	Dim path
	path=inputpath
	If path=""  Then 
		GetPath=path
	Else 
		If RZ_ROOT="" Or Left(RZ_ROOT,1)<>"/" Or Right(RZ_ROOT,1)<>"/" Then 
			WriteError("RZ_ROOT必须以/开头和/结尾，请检查config.inc.asp")
		End If
		If Left(path,1)="/" Then 
			GetPath=inputpath
		End If 
		GetPath=Replace(RZ_ROOT&path,"//","/")
	End If 
End Function


'处理!{}标记（包含.html文件）
Function ExecInclude(content) 
	Dim pattern,regEx,Matches,Match,result,foundval,filepath,newval
	pattern="!\{\S*?\}"
	Set regEx=new RegExp
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(content)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	If Matches.count <>0 Then
		for each Match in Matches
			foundval=Match.value
			filepath=Mid(foundval,3)
			filepath=Left(filepath,Len(filepath)-1)
			If Left(filepath,1)="/" Then 
				newval=ReadHTMLFile(GetPath(filepath))
			Else
				newval=ReadHTMLFile(GetPath(S_TEMPLATEDIR&"/"&filepath))
			End If 
			content=Replace(content,foundval,newval)
		Next
	End If
	set regEx=Nothing
	ExecInclude=content
End Function

'处理.html，并输出结果
Function Include(templatepath) 
	Dim template
	template=ReadHTMLFile(GetPath(templatepath))
	template=ExecInclude(template)
	template=ExecRZTag(template)
	If IsObject(S_CRUMB) Then 
	sys_seokeyword=S_CRUMB.HeaderKeyword
	sys_seotitle=S_CRUMB.HeaderTitle
	sys_seodescription=S_CRUMB.HeaderTitle
	sys_crumb=S_CRUMB.GetResult
	End If 
	template=SystemTags(template)
	response.write(template)
End Function

'处理.html，但不直接输出，主要是为了seo（仅供系统使用）
Function SysInclude(templatepath) 
	Dim template
	template=ReadHTMLFile(GetPath(S_TEMPLATEDIR&"/"&templatepath))
	template=ExecInclude(template)
	template=ExecRZTag(template)
	S_TEMPLATE=S_TEMPLATE&template
End Function

'输出结果
Function Flush()
	If IsObject(S_CRUMB) Then 
	sys_seokeyword=S_CRUMB.HeaderKeyword
	sys_seotitle=S_CRUMB.HeaderTitle
	sys_seodescription=S_CRUMB.HeaderTitle
	sys_crumb=S_CRUMB.GetResult
	End If 
	S_TEMPLATE=SystemTags(S_TEMPLATE)
	S_TEMPLATE=ExecHref(S_TEMPLATE)
	response.write(S_TEMPLATE)
End Function

'不输出结果，只是将结果赋值给S_HTMLMBUFFER
Function FlushToHTML()
	If IsObject(S_CRUMB) Then 
	sys_seokeyword=S_CRUMB.HeaderKeyword
	sys_seotitle=S_CRUMB.HeaderTitle
	sys_seodescription=S_CRUMB.HeaderTitle
	sys_crumb=S_CRUMB.GetResult
	End If 
	S_TEMPLATE=SystemTags(S_TEMPLATE)
	S_TEMPLATE=ExecHref(S_TEMPLATE)
	S_HTMLMBUFFER=S_TEMPLATE
End Function


'处理标签
Function DataBaseTags(content)
	Dim pattern,regEx,Matches,Match,result,foundval,newval,tagval,rs,sql
	pattern="(@\{)(tag)(\.|_|\s)(\w+?)(\})"
	Set regEx=new RegExp   
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(content)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	If Matches.count <>0 Then
		for each Match in Matches
			foundval=Match.value
			tagval=regEx.Replace(foundval,"$4")
			Set rs=server.CreateObject("adodb.recordset")
			sql="select * from [c_tags] where tag_tag='"&tagval&"'"
			rs.open sql,conn,1,1
			If Not rs.eof Then 
			content = Replace(content,foundval,rs("tag_content"))
			End If 
			rs.close
			Set rs=Nothing 
		Next
	End If
	set regEx=Nothing
	DataBaseTags=content
End Function 

'处理@标记（系统内部标记）
Function SystemTags(content) 
	Dim pattern,regEx,Matches,Match,result,foundval,tmpval,tmpval2, newval,tagtype,tagval
	pattern="(@\{)(lang|sys|param|session|cat)(\.|_|\s)([\w\.,\-\[\]]+?)(\})"
	Set regEx=new RegExp   
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(content)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	If Matches.count <>0 Then
		for each Match in Matches
			foundval=Match.value
			tagtype=regEx.Replace(foundval,"$2")
			tagval=regEx.Replace(foundval,"$4")
			Select Case tagtype
				Case "lang":
					newval=eval("getstr(""lang_"&tagval&""")")
					If newval="" Then 
						newval=foundval
					End If 
				Case "param":
					newval=HTMLEncode(request.querystring(tagval))
				Case "session":
					newval=HTMLEncode(session(tagval))
				Case "sys":
					newval=eval("GetSysVars(sys_"&tagval&")")
				Case "cat":
					newval=GetCatURL(tagval)
			End Select 
			If Not IsNull(newval) Then 
				content=Replace(content,foundval,newval)
			End if 
		Next
	End If
	set regEx=Nothing
	SystemTags=content
End Function
Function GetSysVars(sysvar)
	GetSysVars=sysvar
End Function
Function GetCatURL(typeid)
If IsNull(typeid) Or typeid="" Then Exit Function
Dim fenlei,path,pre
fenlei=GetTypeProperty(typeid,"fenlei")
path=CutPath(GetTypeProperty(typeid,"path"))
Select Case fenlei
Case 1: pre=RZ_PRE_ARTICLE_LIST
Case 2: pre=RZ_PRE_PRODUCT_LIST
Case 3: pre=RZ_PRE_PHOTO_LIST
Case 4: pre=""
Case 5: pre=RZ_PRE_GUESTBOOK_LIST
Case 6: pre=RZ_PRE_TYPE_SHOW
Case 7: pre=RZ_PRE_JOB_LIST
End Select 
If pre<>"" Then 
	If S_STATIC=0 Then 
	GetCatURL=GetPath("?"&pre&S_LANG&"-t"&path&".html")
	Else
	GetCatURL=GetPath(RZ_HTML_PATH&"/"&pre&S_LANG&"/t"&Replace(path,",","-")&".html")
	End If
Else
GetCatURL=GetTypeProperty(typeid,"url")
End If 
End Function 

'生成QQ/MSN/EMAIL
Function MakeAccount(qme,stype)
	dim temp,i,result,linkurl,temp_linkurl,str
	Select Case stype
		Case "image":
			str="<img src="""&sys_templatepath&"/images/"&qme&".gif"" alt=""$ACCOUNT$"" style=""border:0px;""/>"
		Case "text":
			str="$ACCOUNT$"
		Case "imagetext":
			str="<img src="""&sys_templatepath&"/images/"&qme&".gif"" alt=""$ACCOUNT$"" style=""border:0px;""/>$ACCOUNT$"
	End Select 
	select case qme
		case "qq":
			If app("rz_company_qq")<>"" Then 
				temp_linkurl="<a target='_blank' href='tencent://message/?uin=$ACCOUNT$&Site=&Menu=yes' title='QQ:$ACCOUNT$'>"&str&"</a>"
				temp=split(app("rz_company_qq"),"|")
			End If 
		case "msn":
			If app("rz_company_msn")<>"" Then
				temp_linkurl="<a target='_blank' href='msnim:chat?contact=$ACCOUNT$' title='MSN:$ACCOUNT$'>"&str&"</a>"
				temp=split(app("rz_company_msn"),"|")
			End If 
		case "email":
			If app("rz_company_email")<>"" Then
				temp_linkurl="<a target='_blank' href='mailto:$ACCOUNT$' title='Email:$ACCOUNT$'>"&str&"</a>"
				temp=split(app("rz_company_email"),"|")
			End If 
	end Select
	If IsArray(temp) Then 
		for i=0 to UBound(temp)
			result=result&Replace(temp_linkurl,"$ACCOUNT$",temp(i))
		Next
	End If 
	MakeAccount=result
End Function

'处理标签
Function ExecRZTag(content)
	Dim pattern,regEx,Matches,Match,result,foundval,template,properties,tagname,tagname2
	pattern="(<!--\{)(rzlist|rzcontent|rzlink|rztype|rzst|rzad)(.*?)(\}-->)([.\s\S]*?)(<!--\{\/)(rzlist|rzcontent|rzlink|rztype|rzst|rzad)(\}-->)"
	Set regEx=new RegExp   
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(content)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	If Matches.count <>0 Then
	for each Match in Matches
		foundval=Match.value
		tagname=regEx.Replace(foundval,"$2")
		properties=regEx.Replace(foundval,"$3")
		template=Trim(regEx.Replace(foundval,"$5"))
		tagname2=regEx.Replace(foundval,"$7")
		If tagname<>tagname2 Then
			Call WriteTagError("<--{"&tagname&"}-->和<--{/"&tagname2&"}-->不匹配",foundval)
		End If 
		Select Case tagname
			Case "rzlist":
				Set S_LIST=ExecRZListProperties(properties)
				S_LIST.Template=template
				result=S_LIST.GetResult
				Set S_LIST=Nothing 
			Case "rzcontent":
				Set S_SHOW=ExecRZContentProperties(properties)
				S_SHOW.Template=template
				result=S_SHOW.GetResult
				Set S_SHOW=Nothing 
			Case "rzlink":
				Set S_SHOW=ExecRZLinkProperties(properties)
				S_SHOW.Template=template
				result=S_SHOW.GetResult
				Set S_SHOW=Nothing 
			Case "rztype":
				Set S_LIST=ExecRZTypeProperties(properties)
				S_LIST.Template=template
				result=S_LIST.GetResult
				Set S_LIST=Nothing 
			Case "rzst":
				Set S_SHOW=ExecRZSTProperties(properties)
				S_SHOW.Template=template
				result=S_SHOW.GetResult
				Set S_SHOW=Nothing
			Case "rzad":
				Set S_LIST=ExecRZADProperties(properties)
				S_LIST.Template=template
				result=S_LIST.GetResult
				Set S_LIST=Nothing
		End Select 
		content=Replace(content,foundval,result)

	Next 

	End If

	set regEx=Nothing

	ExecRZTag=content
End Function

'获取属性值中的param.xxx和session.xxx的值
Function ProValue(str)
Dim pattern,regEx,Matches,Match,result,foundval,tmpval,tmpval2, newval,tagtype,tagval
	pattern="(\[)(param|session|app|sys)(\.)([\w]+?)(\])"
	Set regEx=new RegExp   
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(str)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	If Matches.count <>0 Then
		foundval=Matches(0).value
		tagtype=regEx.Replace(foundval,"$2")
		tagval=regEx.Replace(foundval,"$4")
		Select Case tagtype
			Case "param":
				newval=HTMLEncode(request.querystring(tagval))
			Case "session":
				newval=HTMLEncode(session(tagval))
			Case "app":
				newval=HTMLEncode(app(tagval))
			Case "sys":
				newval=eval("GetSysVars(sys_"&tagval&")")
		End Select
	Else
		newval=str
	End If
	set regEx=Nothing
	ProValue=newval
End Function 


'处理rzlist的属性
Function ExecRZListProperties(properties)
	Dim pattern,regEx,Matches,Match,result,foundval,pageflag
	pattern="(type|titlelength|contentlength|showpagenum|specialid|pagesize|number|sort|typeids|lang|path|htmlclear|notshow|havephoto)(=\"")(\S+?)(\"")"
	Set regEx=new RegExp   
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(properties)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	If InStr(properties,"type=")=0 Then Call WriteTagError("rzlist的type属性必须指定：取值为article、photo、product、special、guestbook、recordcomment,job",properties)
	Set S_LIST = new RZList
	pageflag=0
	If Matches.count >0 Then
		Dim key,value
		for each Match in Matches
			foundval=Match.value
			key=regEx.Replace(foundval,"$1")
			value=ProValue(regEx.Replace(foundval,"$3"))
			S_LIST.ObjRZParam=S_RZParam
			If key="type" Then 
				S_LIST.ListType=value
			End If 
			If key="titlelength" And isNumber(value) Then
				S_LIST.TitleLength=value
			End If 
			If key="contentlength" And isNumber(value) Then 
				S_LIST.ContentLength=value
			End If 
			If key="specialid"  Then 
				S_LIST.Specialid=value
			End If 
			If key="showpagenum" Then
				If value="1" Or value="2" Or value="0" Then
					S_LIST.ShowPageNum=CInt(value)
					If value="1" Or value="2" Then
						Set S_RZPAGE=new RZPage
						pageflag=1
					End If 
				End If 
			End If 
			If key="typeids" Then
				If value<>"" Then
					If(CheckIds(value)) Then 
						S_LIST.Typeids=value
					else
						Call WriteTagError("分类格式不合法，分类id之间用逗号分隔，例子：12,28",properties)
					End If
				End if 
			End If
			If key="path" Then
				If value<>"" Then
					If(CheckIds(value)) Then 
						S_LIST.TypePath=value
					else
						Call WriteTagError("分类路径不合法，例子：12,28",properties)
					End If
				End if
			End If
			If key="lang" Then
				If value="1" Or value="0" Then
					S_LIST.Langu=CInt(value)
				End If 
			End If 
			If key="notshow" Then
				If value="1" Or value="0" Then
					S_LIST.NotShow=CInt(value)
				End If 
			End If 
			If key="htmlclear" Then
				If value="1" Or value="0" Then
					S_LIST.HtmlClear=value
				End If 
			End If 
			If key="havephoto" Then
				If value="1" Or value="0" Then
					S_LIST.HavePhoto=value
				End If 
			End If 
			If key="number" Then
				If isNumber(value) Then
					S_LIST.RecordNumber=CInt(value)
				End If 
			End If 
			If key="sort" Then
				If isNumber(value) Then
					If value<=8 Then 
					S_LIST.TheOrder=CInt(value)
					End If 
				End If 
			End If
			If key="pagesize" Then
				If IsObject(S_RZPAGE) And (isNumber(value) Or value="x" Or value="X") Then
					If value="x" Or value="X" Then 
						value=GetTypeProperty(S_RZPARAM.Typeid,"perpage")
						If value="" Then WriteTagError("不能获取此分类的pagesize值，x只能用于分类列表页")
					End If 
					S_RZPAGE.PageSize = CInt(value)
				Else
					Call WriteTagError("showpagenum属性值必须为1或2时才能设置pagesize属性，pagesize的值只能为正整数或x",properties)
				End If 
			End If 
		Next
	End If
	set regEx=Nothing
	If pageflag=1 And IsObject(S_RZPAGE) Then
		S_LIST.ObjRZPage=S_RZPAGE
	End If 
	Set ExecRZListProperties=S_LIST
End Function 

'处理rzcontent的属性
Function ExecRZContentProperties(properties)
	Dim pattern,regEx,Matches,Match,result,foundval
	pattern="(id|type|titlelength|contentlength|shownext|htmlclear|settitle)(=\"")(\w+?)(\"")"
	Set regEx=new RegExp   
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(properties)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	If InStr(properties,"type=")=0 Then Call WriteTagError("rzcontent的type属性必须指定：取值为article、photo、product、special",properties)
	Set S_SHOW = new RZContent
	If Matches.count >0 Then
		Dim key,value
		for each Match in Matches
			foundval=Match.value
			key=regEx.Replace(foundval,"$1")
			value=ProValue(regEx.Replace(foundval,"$3"))
			S_SHOW.ObjRZParam=S_RZParam
			If key="type" Then 
				S_SHOW.ContentType=value
			End If 
			If key="titlelength" And isNumber(value) Then
				S_SHOW.TitleLength=value
			End If 
			If key="contentlength" And isNumber(value) Then 
				S_SHOW.ContentLength=value
			End If 
			If key="shownext" Then
				If value="1" Or value="0" Then
					S_SHOW.ShowNext=CInt(value)
				End If 
			End If 
			If key="clearhtml" Then
				If value="1" Or value="0" Then
					S_SHOW.ClearHtml=CInt(value)
				End If 
			End If 
			If key="id" Then
				If isNumber(value) Then
					S_SHOW.ID=CInt(value)
				End If 
			End If 
			If key="settitle" Then
				If value="0" Or value="1" Then 
					S_SHOW.SetTitle=value
				End If 
				If Not IsObject(S_CRUMB) Then 
				Set S_CRUMB=new RZCrumb
				End If 
			End If 
		Next
	End If
	set regEx=Nothing
	Set ExecRZContentProperties=S_SHOW
End Function 

'处理rztype的属性
Function ExecRZTypeProperties(properties)
	Dim pattern,regEx,Matches,Match,result,foundval
	pattern="(parentid|types|samelevel|depth|notshow|allrecord|recordnumber)(=\"")(\S+?)(\"")"
	Set regEx=new RegExp   
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(properties)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	If InStr(properties,"depth=")=0 Then Call WriteTagError("rztype必须指定depth属性",properties)
	Set S_LIST = new RZSubType
	If Matches.count>0 Then
		Dim key,value
		for each Match in Matches
			foundval=Match.value
			key=regEx.Replace(foundval,"$1")
			value=ProValue(regEx.Replace(foundval,"$3"))
			If key="parentid" Then 
				If isNumber(value) Then 
					S_LIST.TypeId=value
				Else
					Call WriteTagError("rztype的id属性必须为数值",properties)
				End If 
			End If 
			If key="recordnumber" Then 
				If isNumber(value) Then 
					S_LIST.RecordNumber=value
				Else
					Call WriteTagError("rztype的recordnumber属性必须为数值",properties)
				End If 
			End If 
			If key="samelevel" Then 
				If value="0" Or value="1" Then 
					S_LIST.SameLevel=value
				Else
					Call WriteTagError("rztype的samelevel属性必须为0或1",properties)
				End If 
			End If 
			If key="notshow" Then 
				If value="0" Or value="1" Then 
					S_LIST.NotShow=value
				Else
					Call WriteTagError("rztype的notshow属性必须为0或1",properties)
				End If 
			End If 
			If key="allrecord" Then 
				If value="0" Or value="1" Then 
					S_LIST.AllRecord=value
				Else
					Call WriteTagError("rztype的allrecord属性必须为0或1",properties)
				End If 
			End If 
			If key="depth" Then 
				If isNumber(value) And value<>"0" Then 
					S_LIST.Depth=value
				Else
					Call WriteTagError("rztype的depth属性必须为大于1的整数",properties)
				End If 
			End If 
			If key="types" Then
				If value<>"" Then
				Dim i,v
				For i=1 To Len(Trim(value))
					v=Mid(value,i,1)
					If Instr("0123456789,",v)<=0 Then
						Call WriteTagError("分类类型不合法，分类类型之间用逗号分隔，取值为1-8，例子：1,2",properties)
					End If
				Next
				S_LIST.TypeClass=value
				End If
			End If
		Next
	End If
	set regEx=Nothing
	Set ExecRZTypeProperties=S_LIST
End Function 

'处理rzst的属性
Function ExecRZSTProperties(properties)
	Dim pattern,regEx,Matches,Match,result,foundval
	pattern="(id|type|titlelength|contentlength|htmlclear|ifcontent|ifimage)(=\"")(\S+?)(\"")"
	Set regEx=new RegExp   
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(properties)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	If InStr(properties,"type=")=0 Then Call WriteTagError("rzst的type属性必须指定：type或special",properties)
	Set S_SHOW = new RZST
	If Matches.count >0 Then
		Dim key,value
		for each Match in Matches
			foundval=Match.value
			key=regEx.Replace(foundval,"$1")
			value=ProValue(regEx.Replace(foundval,"$3"))
			If key="id" Then 
				If isNumber(value) Then 
					S_SHOW.Id=value
				Else
					Call WriteTagError("rztype的id属性必须为数值",properties)
				End If 
			End If 
			If key="type" Then
				If value="type" Or value="special" Then
				S_SHOW.TypeSpecial=value
				End If
			End If
			If key="titlelength" And isNumber(value) Then
				S_SHOW.TitleLength=value
			End If 
			If key="contentlength" And isNumber(value) Then 
				S_SHOW.ContentLength=value
			End If 
			If key="htmlclear"  Then
				If value="0" Or value="1" Then 
					S_SHOW.HtmlClear=value
				End If 
			End If 
			If key="ifimage"  Then
				If value="0" Or value="1" Then 
					S_SHOW.IfImage=value
				End If 
			End If 
			If key="ifcontent"  Then
				If value="0" Or value="1" Then 
					S_SHOW.IfContent=value
				End If 
			End If 
		Next
	End If
	set regEx=Nothing
	Set ExecRZSTProperties=S_SHOW
End Function 

'处理rzad的属性
Function ExecRZADProperties(properties)
	Dim pattern,regEx,Matches,Match,result,foundval
	pattern="(ids|type|random|number|series|separator|width|height)(=\"")(\S+?)(\"")"
	Set regEx=new RegExp   
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(properties)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	If InStr(properties,"type=")=0 Then Call WriteTagError("rzad的type属性必须指定：取值为“text”（文本）、“photo”（图片）、“flash”、“code”（代码）",properties)
	Set S_LIST= new RZAdvertise
	If Matches.count >0 Then
		Dim key,value
		for each Match in Matches
			foundval=Match.value
			key=regEx.Replace(foundval,"$1")
			value=ProValue(regEx.Replace(foundval,"$3"))
			If key="ids" Then 
				S_LIST.Ids=value
			End If 
			If key="type" Then
				If value="text" Or value="photo" Or value="flash" Or value="code" Then
					Dim adtype
					Select Case value
						Case "text":
							adtype="1"
						Case "photo":
							adtype="2"
						Case "flash":
							adtype="3"
						Case "code":
							adtype="4"
					End Select 
					S_LIST.ADType=adtype
				End If
			End If
			If key="random"  Then
				If value="0" Or value="1" Then 
					S_LIST.Random=value
				End If 
			End If 
			If key="series"  Then
				If value="0" Or value="1" Then 
					S_LIST.Series=value
				End If 
			End If 
			If key="separator"  Then
				S_LIST.Separator=value
			End If 
			If key="number" And isNumber(value) Then 
				S_LIST.Num=value
			End If 
			If key="width" And isNumber(value) Then 
				S_LIST.PhotoWidth=value
			End If 
			If key="height" And isNumber(value) Then 
				S_LIST.PhotoHeight=value
			End If 
		Next
	End If
	set regEx=Nothing
	Set ExecRZADProperties=S_LIST
End Function 

'处理rzlink的属性
Function ExecRZLinkProperties(properties)
	Dim pattern,regEx,Matches,Match,result,foundval
	pattern="(id|ids|random|number|titlelength)(=[\'|\""])(\S+?)([\'|\""])"
	Set regEx=new RegExp   
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(properties)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	If InStr(properties,"number=")=0 Then Call WriteTagError("rzlink的number属性必须指定：0为全部显示，正整数为要显示的数量",properties)
	Set S_SHOW = new RZFriendLink
	If Matches.count >0 Then
		Dim key,value
		for each Match in Matches
			foundval=Match.value
			key=regEx.Replace(foundval,"$1")
			value=ProValue(regEx.Replace(foundval,"$3"))
			If key="id" And isNumber(value) Then 
				S_SHOW.Id=value
			End If 
			If key="ids" Then 
				S_SHOW.Ids=value
			End If 
			If key="random" Then
				If value="0" Or value="1" Then 
					S_SHOW.Random=value
				End If 
			End If 
			If key="number" And isNumber(value) Then 
				S_SHOW.Num=value
			End If 
			If key="titlelength" And isNumber(value) Then
				S_SHOW.TitleLength=value
			End If 
		Next
	End If
	set regEx=Nothing
	Set ExecRZLinkProperties=S_SHOW
End Function 

'将图片flash链接地址改为相对于模板路径的地址
Function ExecTemplateHref(content) 
	Dim pattern,regEx,Matches,Match,result,foundval,url,newval,flag,tag,sor,flashpattern
	pattern="(<img|<link|<embed|<script|<input|<param)([.\s\S]*?)(src|href|value)(=[\'|\""])(\S*?)([\'|\""])([.\s\S]*?)(>)"
	Set regEx=new RegExp
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(content)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	flashpattern="(<param\s*?name=[\'|\""]movie[\'|\""]\s*?value=[\'|\""])(\S*?)([\'|\""])"
	If Matches.count <>0 Then
		for each Match in Matches
			foundval=Match.value
			tag=regEx.Replace(foundval,"$1")
			sor=regEx.Replace(foundval,"$3")
			url=regEx.Replace(foundval,"$5")
			flag=0
			If (tag="<img" And sor="src") Or (tag="<link" And sor="href") Or (tag="<embed" And sor="src") Or (tag="<script" And sor="src") Or (tag="<input" And sor="src")  Then 
			flag=1
			End If 
			If (tag="<param" And sor="value") Then 
				If TestPattern(foundval,flashpattern) Then flag=1
			End If 
			If flag=1 Then 
				If Not InStr(url,":")>0 And Left(url,1)<>"#" And left(url,1)<>"$" And Left(url,1)<>"@"  And Left(url,1)<>"<"  Then 
					If Left(url,1)<>"/"  Then '如果不是以“/”开头则在模板目录查找
						newval=Replace(foundval,url,GetPath(S_TEMPLATEDIR&"/"&url))
					Else 
						newval=foundval
					End If 
					content=Replace(content,foundval,newval)
				End If 
			End If 
		Next
	End If
	set regEx=Nothing
	ExecTemplateHref=content
End Function

'将超链接地址改为相对于根路径的地址
Function ExecHref(content) 
	Dim pattern,regEx,Matches,Match,result,foundval,url,newval
	pattern="(<a)([.\s\S]*?)(href)(=[\'|\""])([.\s\S]*?)([\'|\""])([.\s\S]*?)(>)"
	Set regEx=new RegExp
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(content)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	If Matches.count <>0 Then
		for each Match in Matches
			foundval=Match.value
			
			url=regEx.Replace(foundval,"$5")
			If Not InStr(url,":")>0 And Left(url,1)<>"#" And Left(url,1)<>"?" And left(url,1)<>"$" And Left(url,1)<>"@"  And Left(url,1)<>"<"  Then 
			
				If Left(url,1)<>"/"  Then '如果不是以“/”开头则在模板目录查找
					newval=Replace(foundval,url,GetPath(url))
				Else 
					newval=foundval
				End If 
				content=Replace(content,foundval,newval)
			End If 
		Next
	End If
	set regEx=Nothing
	ExecHref=content
End Function

'读取某种类型的模板
Function ReadTemplateList(pre,myname)
	Dim fso, objFolder,file, objSubFolders, result
	set fso=server.CreateObject("scripting.filesystemobject")
	on error resume next
	set objFolder=fso.GetFolder(Server.Mappath(GetPath(S_TEMPLATEDIR)))
	result="<option value='"&pre&".html' "
	If myname=pre&".html" Then 
	result=result&" selected" 
	End If
	result=result&">"&pre&".html"&"</option>"
	for Each file In objFolder.files
	If InStr(file.name,pre)=1 And file.name<>pre&".html" Then 
		result=result&"<option value='"&file.name&"'"
		If file.name=myname Then 
			result=result&" selected" 
		End If 
		result=result&">"&file.name&"</option>"
	End If 
	Next 
    Set objFolder=Nothing
    Set fso=Nothing
	ReadTemplateList=result
End Function 

'读取模板
Function GetTemplateName(proc,id)
	If proc<>RZ_PRE_ARTICLE_LIST And proc<>RZ_PRE_ARTICLE_SHOW And proc<>RZ_PRE_PRODUCT_LIST And proc<>RZ_PRE_PRODUCT_SHOW  And proc<>RZ_PRE_PHOTO_LIST And proc<>RZ_PRE_PHOTO_SHOW  And proc<>RZ_PRE_TYPE_SHOW  And proc<>RZ_PRE_SPECIAL_SHOW  And proc<>RZ_PRE_MODULE_SHOW And proc<>RZ_PRE_JOB_LIST And proc<>RZ_PRE_JOB_SHOW And proc<>RZ_PRE_GUESTBOOK_LIST And proc<>RZ_PRE_GUESTBOOK_SHOW And proc<>RZ_PRE_FRIENDLINK_LIST Then 
		WriteError("请求参数有误——"&proc&"前缀不符合规范")
	Exit Function 
	End If 

	Dim rs,sql,templatename,defaulttemplate
	Select Case proc
		Case RZ_PRE_ARTICLE_LIST:
			defaulttemplate="articlelist.html"
		Case RZ_PRE_ARTICLE_SHOW:
			defaulttemplate="articleshow.html"
		Case RZ_PRE_PRODUCT_LIST:
			defaulttemplate="productlist.html"
		Case RZ_PRE_PRODUCT_SHOW:
			defaulttemplate="productshow.html"
		Case RZ_PRE_PHOTO_LIST:
			defaulttemplate="photolist.html"
		Case RZ_PRE_PHOTO_SHOW:
			defaulttemplate="photoshow.html"
		Case RZ_PRE_TYPE_SHOW:
			defaulttemplate="typeshow.html"
		Case RZ_PRE_SPECIAL_SHOW:
			defaulttemplate="specialshow.html"
		Case RZ_PRE_MODULE_SHOW:
			defaulttemplate="model.html"
		Case RZ_PRE_GUESTBOOK_LIST:
			defaulttemplate="guestbooklist.html"
		Case RZ_PRE_GUESTBOOK_SHOW:
			defaulttemplate="guestbookshow.html"
		Case RZ_PRE_FRIENDLINK_LIST:
			defaulttemplate="friendlink.html"
		Case RZ_PRE_JOB_LIST:
			defaulttemplate="joblist.html"
		Case RZ_PRE_JOB_SHOW:
			defaulttemplate="jobshow.html"
	End Select 
	If proc<>RZ_PRE_MODULE_SHOW Then 
		If Not isNumber(id) Then 
			WriteError("请求参数有误——"&id&"必须为数值")
			Exit Function 
		End If 
	End If 
	If proc=RZ_PRE_ARTICLE_LIST Or  proc=RZ_PRE_PRODUCT_LIST Or proc=RZ_PRE_PHOTO_LIST Or proc=RZ_PRE_TYPE_SHOW Or proc=RZ_PRE_GUESTBOOK_LIST Or  proc=RZ_PRE_JOB_LIST Then
		templatename=GetTypeProperty(id,"template")
	ElseIf (proc=RZ_PRE_ARTICLE_SHOW Or proc=RZ_PRE_PRODUCT_SHOW Or proc=RZ_PRE_PHOTO_SHOW Or proc=RZ_PRE_GUESTBOOK_SHOW Or proc=RZ_PRE_JOB_SHOW) Then 
		templatename=GetTypeProperty(id,"recordtemplate")
	ElseIf proc=RZ_PRE_MODULE_SHOW Then 
		templatename=GetModelsProperty(id,"template")
		Dim params,i,param_arr
		params=GetModelsProperty(id,"params")
		If params<>"" Then 
		Dim qstring
		qstring=Request.ServerVariables("QUERY_STRING")
			If InStr(params,",")>0 Then 
				param_arr=Split(params,",")
				For i=0 To UBound(param_arr) 
					If InStr(qstring,"?"&param_arr(i)&"=")=0 And InStr(qstring,"&"&param_arr(i)&"=")=0 Then
					WriteError("请求参数有误！")
					Exit Function 
					End If 
				Next 
			Else
				If InStr(qstring,"?"&params&"=")=0 And InStr(qstring,"&"&params&"=")=0 Then
					WriteError("请求参数有误！")
					Exit Function 
				End If 
			End If 
		End If 
		If IsObject(S_CRUMB) Then 
			S_CRUMB.Str=GetModelsProperty(id,"description")
		End If 
	ElseIf proc=RZ_PRE_SPECIAL_SHOW Then
		Set rs = Server.CreateObject("ADODB.Recordset")
		sql="select template from [c_special] where id="&id
		rs.open sql,conn,1,1
		If not rs.eof Then
			templatename=rs("template")
		End If 
		rs.close
		Set rs=Nothing 
	End If 
	If templatename="" Then
		templatename=defaulttemplate
	End If 
	GetTemplateName=templatename
End Function 

'验证输入的是否为数字
Function isNumber(str)
	isNumber=TestPattern(str,"^\d*?$")
End Function 

'验证输入的是否为字母、数字、下划线
Function isWord(str)
	isWord=TestPattern(str,"^\w*?$")
End Function 

'正则表达式判断
Function TestPattern(str,pattern)
	If IsNull(str) Or str="" Then 
		TestPattern=False
		Exit Function 
	End If 
	Dim regEx
	Set regEx=new RegExp
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=False
	regEx.Global=False
	If regEx.Test(str) Then 
		TestPattern=True 
	Else
		TestPattern=False 
	End If 
End Function 


'查找配对标签
Private Function ExecTemplateTag(content,pattern)
	Dim regEx,Matches,Match,result,foundval,template,properties,tagname,tagname2
	Set regEx=new RegExp   
	regEx.MultiLine = True
	regEx.Pattern=(pattern)
	regEx.IgnoreCase=True
	regEx.Global=True
	Set Matches=regEx.Execute(content)
	If err.number<>0 Then
		response.write "错误:" & err.description
		err.clear
		Exit Function
	End If
	ReDim arr(2)
	If Matches.count <>0 Then
		foundval=Matches(0).value
		tagname=regEx.Replace(foundval,"$2")
		template=Trim(regEx.Replace(foundval,"$4"))
		tagname2=regEx.Replace(foundval,"$6")
		If tagname<>tagname2 Then
			Call WriteTagError("<"&tagname&">和</"&tagname2&">不匹配",foundval)
		End If
		arr(0)=foundval
		arr(1)=template
	End If
	set regEx=Nothing
	ExecTemplateTag=arr
End Function

Function WriteTagError(msg,code)
WriteError(msg&"<br/>****************<br/>"&HtmlEncode(code)&"<br/>****************<br/>")
End Function 

'将时间转换为sitemap格式
Function GoogleSiteMaptime(ntime,style)
If IsNull(ntime) Then  Exit Function 
Dim y, m, d, hh, mm, ss, lastmod
y=Year(ntime)
m=CStr(Month(ntime))
d=CStr(Day(ntime))
hh=CStr(Hour(ntime))
mm=CStr(minute(ntime))
ss=CStr(second(ntime))
If Len(m)=1 Then m="0"&m
If Len(d)=1 Then d="0"&d
If Len(hh)=1 Then hh="0"&hh
If Len(mm)=1 Then mm="0"&mm
If Len(ss)=1 Then ss="0"&ss
Select Case style
Case "y":
	lastmod=y
Case "ym":
	lastmod=y&"-"&m
Case "ymd":
	lastmod=y&"-"&m&"-"&d
Case "ymdhhmm":
	lastmod=y&"-"&m&"-"&d&"T"&hh&":"&mm
Case "ymdhhmmss":
	lastmod=y&"-"&m&"-"&d&"T"&hh&":"&mm&":"&ss
Case default:
	lastmod=y&"-"&m&"-"&d&"T"&hh&":"&mm&":"&ss
End Select 
GoogleSiteMaptime=lastmod
End Function 

Function CheckIds(value)
	Dim i,v,flag
	flag=true
	For i=1 To Len(Trim(value))
		v=Mid(value,i,1)
		If Instr("0123456789,",v)<=0 Then
			flag=False
			Exit For
		End If
	Next
	CheckIds=flag
End Function

Function CheckRequestIds(value)
	Dim i,v,flag
	flag=true
	For i=1 To Len(Trim(value))
		v=Mid(value,i,1)
		If Instr("0123456789|",v)<=0 Then
			flag=False
			Exit For
		End If
	Next
	CheckRequestIds=flag
End Function

'发送邮件
Function SendEmails(subject,content)
Dim rs,sql
Dim smtphost, smtpuser, smtppassword, smtpfromname,smtpmailto
Set rs=server.CreateObject("adodb.recordset")
sql="select * from c_smtp"
rs.open sql,conn,1,1
If Not rs.eof Then
smtphost=rs("smtphost")
smtpuser=rs("smtpuser")
smtppassword=rs("smtppassword")
smtpfromname=rs("smtpfromname")
smtpmailto=rs("smtpmailto")
End If 
rs.close
Set rs=Nothing 
If InStr(smtpmailto,"|")>0 Then 
Dim mailto_arr,i
mailto_arr=Split(smtpmailto)
For i=0 To UBound(mailto_arr)
If mailto_arr(i)<>"" Then 
Call SendOneEmail(smtphost,smtpuser,smtppassword,smtpfromname,mailto_arr(i),subject,content)
End If 
Next 
Else
Call SendOneEmail(smtphost,smtpuser,smtppassword,smtpfromname,smtpmailto,subject,content)
End If 
End Function

Function SendEmailToUser(tomail,subject,content)
Dim rs,sql
Dim smtphost, smtpuser, smtppassword, smtpfromname,smtpmailto
Set rs=server.CreateObject("adodb.recordset")
sql="select * from c_smtp"
rs.open sql,conn,1,1
If Not rs.eof Then
smtphost=rs("smtphost")
smtpuser=rs("smtpuser")
smtppassword=rs("smtppassword")
smtpfromname=rs("smtpfromname")
End If 
rs.close
Set rs=Nothing 
Call SendOneEmail(smtphost,smtpuser,smtppassword,smtpfromname,tomail,subject,content)
End Function

Function SendOneEmail(smtphost,smtpuser,smtppassword,smtpfromname,mailto,subject,content)
On Error Resume Next 
Dim jmail, sendstate
Set jmail = Server.CreateObject("JMAIL.Message")
jmail.silent = true
jmail.logging = true
jmail.Charset = "gb2312"
jmail.ContentType = "text/html"
jmail.AddRecipient mailto
jmail.From = smtpuser
jmail.FromName = smtpfromname
jmail.Subject = subject
jmail.Body = content
'jmail.Priority = 1
jmail.MailServerUserName = smtpuser
jmail.MailServerPassword = smtppassword
sendstate=jmail.Send(smtphost)
jmail.Close()
End Function
%>